ggplotÂ
Date: 2022-06-03
R version: 3.5.0
*Corresponding author: matthew.malishev [at] gmail.com
This document can be found at https://github.com/darwinanddavis/UsefulCode
Same deal as Useful Code 1 and 2 except just gglot because it's too difficult sifting through the other docs.
ggplot functions# option 1
p1 <- p + labs(title = "Option 1") + theme_classic()
p1
# option 2 with inputs to toggle
p2 <- p + labs(title = "Option 2") + theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))
p2
# alternative (after loading ggridges library) theme_ridges(grid=F,center_axis_labels = T)plot_it_now <- function(bg) {
# bg = colour to plot bg
theme(panel.border = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_rect(fill = bg, colour = bg), plot.background = element_rect(fill = bg)) +
theme(axis.line = element_line(color = "white")) + theme(axis.ticks = element_line(color = "white")) +
theme(plot.title = element_text(colour = "white")) + theme(axis.title.x = element_text(colour = "white"),
axis.title.y = element_text(colour = "white")) + theme(axis.text.x = element_text(color = "white"),
axis.text.y = element_text(color = "white")) + theme(legend.key = element_rect(fill = bg)) +
theme(legend.title = element_text(colour = "white")) + theme(legend.text = element_text(colour = "white"))
}
plot_it_now("black")Ref: http://jcborras.net/carpet/visualizing-political-divergences-2012-local-elections-in-helsinki.html
hr.mass.plot <- function(d) {
p <- ggplot(d, aes(HR, Mass, color = colfunc)) + geom_density_2d(data = d, aes(x = HR, y = Mass),
stat = "density2d", position = "identity", color = adjustcolor("orange", alpha = 0.8), size = 1.5,
contour = T, lineend = "square", linejoin = "round")
p <- p + geom_point(data = d, aes(x = HR, y = Mass), color = colfunc, fill = colfunc) + scale_color_manual(values = magma(8))
p <- p + scale_y_continuous(limits = c(-200, 200), name = "Mass lost (g)")
p <- p + scale_x_continuous(limits = c(0, 0.35), name = expression("Home range area (km^2)"))
p <- p + theme_classic()
print(p)
}
hr.mass.plot(d)ggplot when looping through for loop and saving to dirpdf("mypdf.pdf", onefile = T)
for (i in 1:3) {
par(bty = "n", las = 1)
grid.arrange(ggplot(data, aes(x = X, y = Y, fill = ..x..)) + geom_point() + labs(title = paste0("Title_",
i)) + xlab("X") + ylab("Y"))
}
# end loop
dev.off()
# geom_density_ridges() # scale = overlap
# geom_density_ridges(scale = 5, size=0.2,color='white', rel_min_height = 0.01,fill=col,alpha=0.5) +
# scale_fill_viridis option = 'magma', 'inferno','plasma', 'viridis', 'cividis'ggplot (melt package)require(reshape2) # melt package
nn <- 10 # reps
mm <- data.frame(X = rep(LETTERS, nn), Y = sample(nn, replace = T), Z = rep(paste(LETTERS, "_", rnorm(1)),
nn))
# plot
y_m <- melt(mm)
head(y_m)
ggplot(data = y_m, aes(x = X, y = value, group = Z, colour = factor(value))) + geom_point(aes(size = value)) +
geom_line() + theme_classic()xx = sample(100, 100)
yy = rnorm(100)
title1 <- bquote("Density = " ~ r[xy] ~ "and" ~ B^2 ~ +beta ~ alpha)
ggplot() + geom_point(aes(x = xx, y = yy), color = xx) + labs(title = title1, xlab = title1, yab = title1,
colour = title1)ggplot() + scale_color_manual(expression(atop("text", atop(textstyle(epsilon)))))
ggplot() + scale_color_manual(name = expression(atop("Productivity", atop(textstyle((mg ~ C ~ L^{
-1
} ~ d^{
-1
}) # this is bracketed text
)))))require(ggplot2)
xx = sample(100, 100)
yy = rnorm(100)
df <- data.frame(X = xx, Y = yy)
ggplot(df) + geom_point(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_text(aes(xx, yy,
label = xx), check_overlap = T, size = yy + 5) + theme_classic()# add bg label
ggplot() + geom_line(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_label(aes(xx, yy, label = xx),
size = yy + 5, color = yy + 5, fill = xx) + theme_classic()Add text only to final point (plus other methods)
require(directlabels)
df <- tibble("x" = sample(10,5),
"y" = sample(10,5),
"label" = LETTERS[1:5])
ggplot() +
geom_point(data = df, aes(x,y)) +
geom_dl(aes(label = label),
method = list(
dl.trans(x = x + 0.3, y = y + 0), # expand x/y axis to fit in labels
list(dl.combine("first.points","last.points")), cex = 0.5 # add labels to first and last points
)
) +
scale_x_continuous( ..., expand = c(0, 1.5))# use ticks, not quotations
require(ggplot2)
df <- data.frame(X = rnorm(1000), `Y col with spaces` = sample(1000, replace = T))
# incorrect y col, but doesn't throw error
ggplot(df, aes(X, "Y col with spaces")) + geom_line()
# same issue even when matching col name
ggplot(df, aes(X, "Y.col.with.spaces")) + geom_line()
# usable y col
ggplot(df, aes(X, Y.col.with.spaces)) + geom_line()Code Meaning
%a Abbreviated weekday
%A Full weekday
%b Abbreviated month
%B Full month
%c Locale-specific date and time
%d Decimal date
%H Decimal hours (24 hour)
%I Decimal hours (12 hour)
%j Decimal day of the year
%m Decimal month
%M Decimal minute
%p Locale-specific AM/PM
%S Decimal second
%U Decimal week of the year (starting on Sunday)
%w Decimal Weekday (0=Sunday)
%W Decimal week of the year (starting on Monday)
%x Locale-specific Date
%X Locale-specific Time
%y 2-digit year
%Y 4-digit year
%z Offset from GMT
%Z Time zone (character)
require(nycflights13);require(dplyr);require(ggplot2)
flights %>% str
flights$time_hour %>% class # already posix
flights_mod <- flights$time_hour %>% as.character() # convert posix to character
# turn into posix year month day hour minute second format
require(lubridate)
flights_mod <- flights_mod %>% ymd_hms()
flights_mod %>% class
# make new df with fewer data
df <- data.frame("Date"=flights_mod[1:100000],
"Delay"=flights$arr_delay[1:100000])
ggplot(df, aes(Delay,Date)) + geom_tile() +
scale_y_datetime(date_breaks = "1 month",
date_minor_breaks = "1 week", # optional
date_labels = "%B %Y" # full month and year
) +
theme_classic()gridExtrarequire(gridExtra)
nn <- 100 # create sample
p <- ggplot()+geom_point(aes(sample(nn,replace=T),rnorm(nn),size=runif(nn),color=rainbow(nn)),show.legend = F)+theme_classic()
# put plots into list
ggplot_list <- list(p,p,p,p)
# 3 plots above, 1 below
grid.arrange(
grobs = ggplot_list, # list with ggplots or grobs
widths = c(1, 1, 1),
layout_matrix = rbind(c(1, 2, 3),
c(4, 4, 4))
)# 3 plots above with first plot 2 plots wide
grid.arrange(
grobs = ggplot_list, # list with ggplots or grobs
widths = c(2, 1, 1), # widths (2,1,1) of total plots for each row (3)
layout_matrix = rbind(c(1, 2, 3),
c(4, 4, 4))
)# 2 plots below with third plot 3 plots wide
grid.arrange(
grobs = ggplot_list, # list with ggplots or grobs
widths = c(2, 1, 1),
layout_matrix = rbind(c(1, 2, NA),
c(3, 3, 4))
)Arranging multiplot panels
# https://patchwork.data-imaginist.com/articles/guides/assembly.html
# devtools::install_github('thomasp85/patchwork')
require(patchwork)
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp, col = cyl), show.legend = F) + ggtitle("Plot 1") + theme_classic()
p2 <- ggplot(mtcars) + geom_point(aes(mpg, cyl, col = disp), show.legend = F) + ggtitle("Plot 2") + theme_classic()
p3 <- p1
p4 <- p2
# 2 plots, 2 cols
p1 + p2# multi rows
(p1 | p2 | p3)/p4 # 3 plots top, 1 bottom (2 rows) p1/(p2 | p3) # 1 plot top, 2 bottom (2 rows) # 2 plots, 2 rows and 2 cols
wrap_plots(p1, p2, p3, p4)# 3 plots, 2 cols
patch <- p1 + p2
p3 + patch# non ggplot content eg. text
p1 + grid::textGrob("Some text")p1 + gridExtra::tableGrob(mtcars[1:10, c("mpg", "disp")])# title, subs, and captions
patchwork <- (p1 + p2)/p3
patchwork + plot_annotation(title = "ttl", subtitle = "subttl", caption = "caption")# set 'labs' arguments to same title as in 'scale_color_manual'
# legend values automatically matches arguments passed to colvec
# NB specifying the labels arg in scale_color_manual overrides labs
require(ggplot2)
snack_df <- data.frame(
"X"=sample(100,10,replace=F),
"Y"=sample(100,10,replace=F),
"Sum"=runif(10),
"Size"=rep(LETTERS[1:5],each=2)
)
colvec <- colorspace::sequential_hcl(length(unique(snack_df$Size)), "SunsetDark")
legend_ttl <- "This is your legend"
legend_pars <- unique(snack_df$Size) # not run
ggplot(snack_df,aes(X,Y)) +
geom_line(aes(group=Size,color=Size,linetype=Size),size=1) +
geom_point(aes(group=Size,color=Size,shape=Size),size=3) +
scale_color_manual(name=legend_ttl,
# labels = legend_pars, # this overrides labs
values = colvec) +
geom_text(aes(X,Y,
label=c(Size)
),
check_overlap = T,
size=5,vjust=-1,hjust=1.2) +
labs(title="Plot title",x="X",y="Y",
# ----- these are the legend key arguments
colour=legend_ttl,
fill=legend_ttl,
linetype=legend_ttl,
shape=legend_ttl) + # check shape
theme_classic() Option 1
# http://www.rebeccabarter.com/blog/2020-02-05_rstudio_conf/
require(tidyverse)
require(dplyr)
midwest %>% head
plotMidwestTidy <- function(var1, var2) {
ggplot(midwest) + geom_point(aes(x = {
{
var1
}
}, y = {
{
var2
}
} # wrap vars in double curly braces
))
}
plotMidwestTidy(popdensity, poptotal) + theme_bw()Option 2 Can't use character class as user argument
require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"
ggplot(mpg) + geom_point(aes(displ, hwy, colour = colour_var)) + facet_wrap(vars(facet_var)) + my_themePlacing .data in front of your variables and wrapping them with double square braces '[[]]' solves this.
require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"
ggplot(mpg) + geom_point(aes(displ, hwy, colour = .data[[colour_var]])) + facet_wrap(vars(.data[[facet_var]])) +
my_theme + ggtitle(paste0(colour_var, " vs ", facet_var))ggplot objectsrequire(ggplot2)
cond1 <- F
cond2 <- T
p <- ggplot(mtcars) + geom_point(aes(mpg, hp, size = 3), show.legend = F) + theme_classic()
p <- p + if (cond1 == T) {
# execute condition 1 and add to plot
geom_line(aes(mpg, hp, size = 3), color = "red", show.legend = F)
}
p <- p + if (cond2 == T) {
# execute condition 2 and add to plot
geom_line(aes(mpg, hp, size = 2), color = "blue", show.legend = F)
}
pMake calendar plot
require(sugrrants)
require(nycflights13)
ff <- flights
ff <- ff %>% mutate(date = flights$time_hour %>% as.Date())
fdf <- frame_calendar(ff, x = distance, y = arr_delay, date = date, nrow = 4)
p <- ggplot(fdf) + geom_line(aes(x = .distance, y = .arr_delay, group = date)) + theme_void()
p %>% prettify()https://stackoverflow.com/questions/29803253/r-extracting-coordinates-from-spatialpolygonsdataframe
res <- microbenchmark(raster::geom(atf_sp), ggplot2::fortify(atf_sp), spbabel::sptable(atf_sp), as.data.frame(as(as(atf_sp,
"SpatialLinesDataFrame"), "SpatialPointsDataFrame")))
ggplot2::autoplot(res)# rotate
print(p, vp = viewport(angle = -30))
p + coord_flip()
p + scale_y_reverse()
graphics.off()Fill plot view with image
require(png)
require(jpeg)
imgr <- img %>% readPNG()
ggplot() + annotation_raster(imgr, -Inf, Inf, -Inf, Inf)Fill geom with patterns/images https://coolbutuseless.github.io/package/ggpattern/index.html
Read in png, recolor, write as svg, and append to df
here::here("img",paste0(ifh,".png")) %>%
image_read(strip = T) %>%
# image_scale(c(100,100)) %>%
image_fill("transparent") %>%
image_colorize(color = colv_hi,opacity = 70) %>% # recolor img
image_write(here::here("img",paste0(ifh,"2.png")) ,format = "png", depth=NULL)
# append to df
df$img <- here::here("img",paste0(ifh,"2.png"))library(ggplot2)
x <- 1:100
my_geom_y <- function(yy, colour = "black") {
list(geom_line(aes(y = yy), col = colour), data = data.frame(x, yy), geom_point(aes(y = yy), col = colour,
data = data.frame(x, yy)))
}
ggplot(aes(x)) + my_geom_y(x, "red") + my_geom_y(dlnorm(x), "blue") + my_geom_y((x^1.1), "black") + my_geom_y(x/2,
"yellow")Highlight variables in plot
library(ggplot2)
library(gghighlight)
ggplot(mpg, aes(x = cty, y = hwy)) + geom_point(color = "red", size = 2) + gghighlight(class == "midsize")Set inner circle width for circular barplot
ylim <- 40
ggplot() + geom_histogram(data = d, aes(xx, id, fill = yy), size = 0, position = "stack", stat = "identity",
show.legend = F) + scale_fill_manual(values = adjustcolor(colv, 1), aesthetics = c("col", "fill")) +
facet_wrap(~zz) + theme_classic() + coord_polar(start = 0.25) + scale_x_continuous(breaks = 1:12,
labels = xtick) + # option 1
scale_y_continuous(expand = c(0.2, 0)) + # option 2
scale_y_continuous(limits = c(-10, NA), breaks = seq(0, ylim, ylim/4), labels = seq(0, ylim, ylim/4))Add histogram dist to boxplots (from Eli data)
limits <- d$yy %>% unique
colv <- colorspace::sequential_hcl(limits, "Blues")
require(ggdist)
ggplot(data = d, aes(x = xx, y = yy,
col = yy, fill = yy
)) +
geom_boxplot(outlier.color = NA) + # boxplot
geom_jitter(height = 0.2) + # jitter points
ggdist::stat_dots(binwidth = 0.2, # opt 1: dot plot
side = "left",
justification = 1.1,
col = NA) +
ggdist::stat_halfeye(slab_type = "pdf",
limits = c(1, NA), # rm data < 1
adjust = 0.5, # opt 2: point dist
width = 0.5,
.width = 0, # decrease iqr line width
justification = -0.5, # move dist above box
point_colour = NA) +
scale_y_discrete(limits=limits) + # reorder xaxis
scale_colour_manual(values = colv,aesthetics = "col", limits = limits, labels = limits) + # keep solid col for boxplot
scale_fill_manual(values = adjustcolor(colv,0.7), aesthetics = "fill",limits = limits, labels = limits) + # add alpha to boxplot fill
theme_classic()### opt 1 first create and save plot inset to local dir
plot_inset <- ggplot() + geom_point(data = inset_data)
#
ggsave("plot_inset.png", plot_inset)
plot_inset <- "plot_inset.png" %>% readPNG() # read in saved plot
# main plot
ggplot() + geom_sf(data = data) + # add plot inset
annotation_raster(plot_inset, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax) + # themes
theme_nothing()
### opt 2
ggdraw() + draw_plot(main1, 0, 0, 1, 1) + draw_plot(legend1, 0.15, 0.7, 0.18, 0.18)Custom shape for legend
# ?draw_key # see available glyphs
require(ggplot2)
require(dplyr)
require(colorspace)
glyph <- "pointrange"
df <- data.frame(xx = rep(1:5,each=3),
yy = 1:15,
group = rep(c("A","B","C"),each=5))
ggplot(data=df,aes(xx,yy,col = group, fill = group)) +
geom_line(key_glyph = glyph) + # set shape for legend
scale_fill_discrete_sequential(name = paste0(glyph, " legend"), "Reds", aesthetics = "col") +
theme_bw() +
guides(col = guide_legend(
override.aes = list(size = 1) # set custom legend size
))Fine tune legend features e.g. text, padding, vertical/horizontal spacing
df <- data.frame(xx = sample(100, 100), yy = rnorm(100))
ggplot(data = df, aes(xx, yy, col = yy, fill = yy)) + geom_point() + theme_classic() + theme(legend.position = "bottom") +
# legend guide for colourbar
guides(fill = guide_colorbar(title = "Continuous", label.position = "left")) + # legend guid for categorical
guides(fill = guide_legend(title = "Categorical", label.position = "right"))Toggle legend when using scale_*_() functions
ggplot() + geom_point(data = df, aes(fill = var1)) + scale_fill_manual(values = colpal, aesthetics = "fill",
guide = F) # T/F to toggle show legend Customise attributes of two separate legends e.g. size and colour bar
# set colourbar for var1 (color gradient) but also change colour/fill of legend for var2 (size)
ggplot() + geom_sf(data = df, aes(col = var1, fill = var1, size = var2)) + # var 1 attributes (colour/fill gradient)
scale_fill_gradientn(name = title1, colours = adjustcolor(colpal, 0.5), aesthetics = c("col", "fill"),
na.value = "#EFEFEF") + # var 2 attributes (size)
guides(size = guide_legend(title = title2, override.aes = list(fill = col_var2, alpha = 0.5, col = col_var2) # change colour for size legend (var2)
))Change legend font, size, bg, opacity, and position
opac <- 0.5
theme(legend.position=c(0.2,0.2), #xy from bottom left
legend.key.size = unit(0.5, "cm"), # size
legend.background = element_rect(fill=alpha(fg, opac)), # legend background
legend.title = element_text(family = family,colour = col_font),
legend.text = element_text(family = family,colour = col_font)
) Biscale legend
require(biscale)
data <- bi_class(df, sf1, sf2, dim = 3)
legend <- bi_legend(pal = "GrPink",
dim = 3,
xlab = "More sf1",
ylab = "More sf2",
size = 12)
map <- ggplot() +
geom_tile(data = data , aes(x = x, y = y, fill = bi_class), show.legend = F) +
bi_scale_fill(pal = "GrPink", dim = 3) + # create biscale
bi_theme()
# combine legend and map
ggdraw() +
draw_plot(map, 0, 0, 1, 1) +
draw_plot(legend, 0.15, 0.7, 0.18, 0.18)Add brackets to axes
# install.packages('lemon')
require(lemon)
ggplot() + geom_jitter(data = mpg, aes(cyl, hwy, colour = class), width = 0.2) + coord_flex_cart(bottom = brackets_horizontal(tick.length = 0))Extract variable name as character
require(ggplot2)
require(palmerpenguins)
my_theme <- theme_classic()
plot_penguin <- function(v1, v2, v3) {
var1 <- ensym(v1) # turn var into character
var2 <- ensym(v2)
var3 <- ensym(v3)
ggplot(penguins) + geom_point(aes({
{
var1
}
}, {
{
var2
}
}, colour = {
{
var3
}
})) + my_theme + ggtitle(paste0(var1, " vs ", var2, " by ", var3))
}
plot_penguin(bill_depth_mm, bill_length_mm, species)Set text behind plot area/map/data
ggplot() + geom_text(data = ttl, aes(x, y, label = label), check_overlap = T) + geom_sf(data = sf) +
coord_sf(crs = prj, xlim = c(bbox[1], bbox[3]), ylim = c(bbox[2], bbox[4])) + labs(x = NULL, y = NULL) +
# themes
theme_nothing() + theme(panel.grid.major = element_line(colour = border, linetype = 3, size = 0.2), plot.background = element_rect(fill = "transparent",
colour = NA), panel.background = element_rect(fill = "transparent"), axis.text = element_blank(),
axis.ticks.length = unit(0, "null"), plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), "mm"), panel.ontop = F)Customise ggplot text with colours
require(ggtext)
ttl <- paste0("<span style='font-family: Avenir;'>Climate risk in Vietnam <br>
<span style='font-size: 30pt'> Exposure of
<span style='color:",colv1,";'>Coffee</span>,
<span style='color:",colv2,";'>Cashew</span>, and
<span style='color:",colv3,";'>Cassava</span>
</span></span>") %>% purrr::map(htmltools::HTML)
p + theme(plot.title = element_markdown(lineheight = 1)) + # add custom ggtext
labs(title = ttl)
# vlist <- c(coff,cash,cass)
# lapply(vlist,function(x) {colnames(x) = rep(c('Index',"geometry"),times = vlist %>% length/2)})Add curved arrows/points to text labels, unicode chars, math expressions, etc
require(ggrepel)
require(ggplot2)
set.seed(42)
ggplot(mtcars, aes(wt, mpg, label = carb)) + geom_point(color = "red") + geom_text_repel(nudge_x = 0.15,
box.padding = 0.5, nudge_y = 1, segment.curvature = -0.1, segment.ncp = 3, segment.angle = 20)